perm filename TYPESE.SAI[P,JRA]2 blob
sn#304588 filedate 1977-09-09 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00024 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00004 00002 DEFINE CRLF="('15&'12)", !="comment", proc="simple procedure",
C00011 00003 ! define punch(x)=⊂wordout(ptpchan,x)⊃
C00012 00004 boolean procedure defile(integer chan string file,ext,pj,pn) begin ! file defaults
C00013 00005 proc cw_init(string sinteger n)
C00014 00006 ! procedure typeset(string s)
C00016 00007 proc punch_num(string s)
C00017 00008 proc tab_set(integer n)
C00019 00009 define
C00021 00010 ! character width stuff
C00022 00011 proc stuff(integer x) ! x is tty code, jam it in punch buffer
C00023 00012 procedure film_adv(string s) ! s is string rep of point, half-point advance
C00024 00013 procedure line_meas(integer n) ! n is pixel width of page. punch it
C00025 00014 proc indentto(integer n) ! manufacture the "bellIL" sequence
C00026 00015 proc tab_to(integer n) ! manufacture the guts of the bell X-Y
C00027 00016 ! proc setfont(integer n)
C00029 00017 ! proc burp( reference integer array p: integer sup1, sub1, text)
C00031 00018 ! proc punch_sum(string s)
C00032 00019 ! procedure setline ! end of line routine. must check for sup/sub hacking
C00035 00020 ! proc linesp(integer n)
C00036 00021 begin "MAIN PROGRAM"
C00038 00022 add crap for page number location (suck for "<FF>")
C00039 00023 read page 1
C00042 00024 page←2
C00046 ENDMK
C⊗;
DEFINE CRLF="('15&'12)", !="comment", proc="simple procedure",
crlfff="('15&'12&'14)",
crlfffsp="('15&'12&'14&'40)",
INCHAN=1,PTPCHAN=2,fontchan=3;
BEGIN "TYPESET"
require"⊂⊃⊂⊃"delimiters;
string s,s1,slead,swidth,ext;
integer lead,lmar,xline,width,pwidth,i,eof,pagebeg,pagend;
integer page,tolb,torb,tospeq,offset; ! offset is running left margin;
integer todot,tocolon;
boolean foo; ! the punch debug flag;
define debug(x)=⊂⊃;
! define debug(x)=⊂outstr(x)⊃;
PRELOAD_with
"Feed",
" th_sp ",
"e",
"3",
" ELEV",
"feed",
"a",
"$",
comment 10;
" ",
" adth ",
"s",
" emsp ",
"i",
"8",
"u",
"7",
comment 20;
"ret",
"'",
"d",
"-",
"r",
"4",
"j",
"BELL",
comment 30;
"n",
",",
"f",
" QL",
"c",
" ENSP ",
"k",
" QR",
comment 40;
"t",
"5",
"z",
")",
"l",
"SS",
"w",
"2",
comment 50;
"h",
" EML ",
"y",
"6",
"p",
"0",
"q",
" ENL ",
comment 60;
"o",
"9",
"b",
" URL ",
"g",
";",
"↑",
"LRL",
comment 70;
"m",
".",
"x",
"1",
"v",
" QC ",
"↓",
"RUB";string array vip[0:64];
PRELOAD_with
"a1","a5","b1","a1","c6","b1","a3","a1","a3","b6","a3","a4","a4","b5","a3","a3";
string array font[0:16];
PRELOAD_with
"10","10","10","07","10","10","10","07","10","24","10","08","10","10","10","10";
string array fontsize[0:16]; ! an extra slot for vip specials;
PRELOAD_with
0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0,
'15, 0, 0, 0, 0, 0, 0, 0,
0, '07, 0, 0, -'07, '23, '61, -'21,
'43, -'43, 0, 0, -'31, -'23, -'71, 0,
-'55, -'73, -'47, -'03, -'25, -'41, -'53, -'17,
-'15, -'61, '65, -'65, 0, 0, 0, '55,
0, '06, '62, '34, '22, '02, '32, '64,
'50, '14, '26, '36, '44, '70, '30, '60,
'54, '56, '24, '12, '40, '16, '74, '46,
'72, '52, '42, 0, 0, 0, 0, 0,
'21, -'06, -'62, -'34, -'22, -'02, -'32, -'64,
-'50, -'14, -'26, -'36, -'44, -'70, -'30, -'60,
-'54, -'56, -'24, -'12, -'40, -'16, -'74, -'46,
-'72, -'52, -'42, 0, 0, 0, 0, 0;
integer array chrtbl[0:128]; ! table encoding p-45 vip codes;
! table is indexed by ascii code;
! if entry is positive then its an uppercase character;
! if negative then it's a lower case;
! if entry is zero then hack special( typically greek math strip);
integer array cw[0:17,0:127]; ! font-character width array;
integer tab_cnt,! number of tabs set in line. used as index in tab_buf;
last_col;! last column set. current minus this gives bell setting;
string array tab_buf[0:20]; ! contains string rep of point pica setting;
integer run_lngth; ! used to count line length based on chr.width and COL INC's;
boolean seen_bnd; ! used in optimizer: no bands → no change in width;
integer page1,
topar, ! break table for parens;
loc, ! index in punch buffer;
supfont,! index of superscript font;
subfont;! for subscripts;
real pix_pnt; ! 200/72;
integer array punch_buf[0:1000];
boolean mon, ! `minus on' when is sum-script mode;
sup, ! a superscript is in the line;
sub, ! a subscript appears;
uc; ! upper case flag;
! next variables are used to minimize the crap put on tape;
! removing unnecessary font, point size, and indent changes;
string cur_size; ! current point size;
integer cur_font_no; ! current font number;
integer cur_indent; ! current indentation;
boolean text_set; ! true if current line has text characters (non-bells);
! tty codes (yuk);
define bell='27,
eight='15,
eexx='72,
jay='26,
emm='70,
comma='31,
period='71,
eff='32,
elll='44,
yyii='52,
you='16,
zee='42,
ensp='35,
bnd='10,
thin='1,
ql='33,
elev='04,
shift='66,
unshift='76,
supershift='45;
define flash='15,
noflash='61; ! these are for sumscripts( 8 and 9 in tty code)!;
define bellit=⊂begin
if not uc then stuff(bell)
else begin stuff(unshift);
stuff(bell);
uc←false;
end;
end⊃;
integer toppn; ! break table for ppn;
! define punch(x)=⊂wordout(ptpchan,x)⊃;
proc punch(integer x);
begin
if foo then outstr(vip[x]&crlf)else wordout(ptpchan,x);
end;
boolean procedure defile(integer chan; string file,ext,pj,pn); begin ! file defaults;
integer nam,ex,ppn; string sppn;
boolean flag;
nam←cvfil(file,ex,ppn); sppn←cvxstr(ppn);
sppn←"["&(if ppn lsh -18 then sppn[1 to 3] else pj)&","&
(if ppn land '777777 then sppn[4 to 6] else pn)&"]";
lookup(chan,(file←cvxstr(nam)&".")&cvxstr(ex)&sppn,flag);
if flag ∧ ex=0 then lookup(chan,file&ext&sppn,flag);
return(flag) ! TRUE if file not found;
end;
proc cw_init(string s;integer n);
begin "cw" string s1,file;integer i;boolean flag;
open(fontchan,"DSK",'14,2,0,0,0,eof);
s1←scan(s,toppn,i);
if length(s)=0 then file ← s1&".fnt[xgp,sys]"
else file ← s1&".fnt"&s;
lookup(fontchan,file,flag);
if flag then begin outstr("font not found");return;end;
for i←0 step 1 until 127 do
cw[n,i] ← wordin(fontchan) LSH -18;
if n=0 then begin "lead"
lead←wordin(fontchan); ! junk it;
lead←wordin(fontchan); ! get chr height;
end "lead";
release(fontchan);
end"cw";
! procedure typeset(string s);
forward proc setfont(integer n);
forward proc stuff(integer n);
forward proc tab_to(integer n);
forward proc typeset(string s);
forward proc special(string s);
proc typeset(string s);
begin "ty" integer s1;
debug(s&crlf);
while s ≠null do
begin "loop"
s1←lop(s);
if chrtbl[s1]>0 then begin
if uc then stuff(chrtbl[s1])
else begin stuff(shift);
stuff(chrtbl[s1]);
uc←true
end
end
else if chrtbl[s1]<0 then begin
if uc then begin stuff(unshift);
stuff(-chrtbl[s1]);
uc←false
end
else stuff(-chrtbl[s1])
end
else special(s1);
end "loop";
end "ty";
proc punch_num(string s);
begin "num" integer s1;
while s ≠null do
begin "loop"
s1←lop(s);
if chrtbl[s1]>0 then begin
outstr("bad pica-points for tab");
end
else if chrtbl[s1]<0 then begin
punch(-chrtbl[s1])
end
else outstr("bad pica-points for tab");
end "loop";
end"num";
proc tab_set(integer n);
begin "ty" integer i;string s;
i←1;
punch(bell);
punch(eexx);
while i<n do
begin "loop1"
s←tab_buf[i];
debug(s&crlf);
punch_num(s);
punch(bnd);
i←i+1;
end"loop1";
s←tab_buf[n];
debug(s&crlf);
punch_num(s);
punch(bell);
punch(yyii);
punch(bell);
punch(you);
end "ty";
define
grkss(n)=⊂begin
stuff(supershift);
stuff(n);
stuff(unshift);
uc←false;
end⊃,
grkuc(n)=⊂begin
if uc then stuff(n)
else begin stuff(shift);
stuff(n);
uc←true;
end;
end⊃,
grklc(n)=⊂begin
if not uc then stuff(n)
else begin stuff(unshift);
stuff(n);
uc←false
end;
end⊃;
proc special(string c); ! hack non-p45 character;
begin "sp"
integer n;
n←cur_font_no;
setfont(16);
if c="≤" then grkss('47)
else if c="<" then grkss('07) ! $;
else if c="=" then grklc('25) ! "4";
else if c="≥" then grkss('03) ! "3";
else if c=">" then grkss('73) ! "1";
else if c="{" then grkuc('25) ! "4";
else if c="}" then grkuc('41) ! "5";
else if c="≡" then grkss('15) ! "8";
else if c="+" then grklc('73) ! "1";
else if c="[" then grkuc('47) ! "2";
else if c="]" then grkuc('03) ! "3";
else if c="∞" then grklc('07) ! "$";
else if c="""" then grklc('55) ! "0";
else grkuc('56); ! "q";
setfont(n)
end "sp";
! character width stuff;
integer proc comp_lngth(string s);
begin "comp" integer n, s1;string s2;
! s2←s;
n←0;
while s≠null do
begin "loop"
s1←lop(s);
n←cw[cur_font_no,s1]+n;
end "loop";
! outstr("length of "&s2&" is"&cvs(n)&crlf);
return(n);
end"comp";
proc stuff(integer x); ! x is tty code, jam it in punch buffer;
begin
debug("stuff"&cvos(x)&crlf);
punch_buf[loc]←x;
loc←loc+1;
end;
procedure film_adv(string s); ! s is string rep of point, half-point advance;
begin
punch(bell);
punch(eff);
setformat(-3,0);
punch_num(s);
end;
procedure line_meas(integer n); ! n is pixel width of page. punch it;
begin integer pt;
punch(bell);
punch(elll);
pt←(n-offset)/pix_pnt;
setformat(-4,0);
punch_num(cvs((pt DIV 12)*100+(pt MOD 12)));
end;
proc indentto(integer n); ! manufacture the "bellIL" sequence;
! this should be optimized to kill the film advance;
begin "IN"
if n≠cur_indent then begin "chngind"
integer pt;
string s;
setformat(-4,0);
pt←(n-370.)/pix_pnt;
s←cvs((pt DIV 12)*100+(pt MOD 12));
if text_set then begin
stuff(ql);
bellit;
typeset("m"&slead&",");
end;
bellit;
typeset("il"&s);
cur_indent←n
end "chngind"
end "IN";
proc tab_to(integer n); ! manufacture the guts of the bell X-Y;
! sequence;
begin "IN"
integer pt,m;
string s;
if n=offset then begin last_col←n;return;end;
setformat(-4,0);
m←(n-last_col);
last_col←n;
pt←m/pix_pnt;
s←cvs((pt DIV 12)*100+(pt MOD 12));
debug("tab is "&cvs(n)&";output is "&s&crlf);
if equ(s,"0000") then s←"0001";
tab_cnt←tab_cnt+1;
tab_buf[tab_cnt]←s;
if text_set then stuff(elev) else
begin
stuff(ql);
stuff(elev);
end;
end "IN";
! proc setfont(integer n);
! crap to handle superscript and subscripts using flash-noflash hack.
when a sumscript is first recognized in line building,
(at font change) the bell sequence is made but with -1 or -2
at tthe flash position, the NEXT font change is recognized also
and a flash sequence is built with -3. at the end of the line
"setline" recognizes that sumscripts have been seen and "burp"s
the appropriate vversions of the line with correct leading
and appropriate substitutions of 8 and 9 for -1, -2, and -3;
define supon=-1,
subon=-2,
texton=-3;
proc setfont(integer n);
begin "SF"
if fontsize[n]≠cur_size then begin
bellit;
typeset("p"&(cur_size←fontsize[n]))
end;
if n≠cur_font_no then begin "curfnt"
bellit;
typeset(font[n]);
if n=supfont then begin
bellit;
stuff(supon);
sup←mon←true;
end
else if n=subfont then begin
bellit;
stuff(subon);
sub←mon←true;
end
else if mon then begin
bellit;
stuff(texton);
mon←false
end;
cur_font_no←n;
end "curfnt";
end "SF";
! proc burp( reference integer array p: integer sup1, sub1, text);
! burp will dump line using flash/no flash crap;
proc burp( reference integer array p; integer sup1, sub1, text);
begin "b" integer i;
! if tab_cnt>0 then tab_set(tab_cnt);
if sup or sub then begin punch(bell);
punch(text)
end;
for i←0 step 1 until loc-1 do
begin "loop"
if p[i]=supon then punch(sup1)
else if p[i]=subon then punch(sub1)
else if p[i]=texton then punch(text)
else punch(p[i]);
end "loop";
punch(elev)
end "b";
! proc punch_sum(string s);
proc punch_sum(string s);
begin "sum"
setformat(-3,0);
if tab_cnt>0 then begin
punch(bell);
punch(zee);
punch(bell);
punch(emm);
punch_num(s);
punch(comma);
punch(bell);
punch(you)
end
else begin
punch(bell);
punch(emm);
punch_num(s);
punch(comma);
end;
end"sum";
! procedure setline; ! end of line routine. must check for sup/sub hacking;
! setline dumps line to punch, it will check sum scripts;
procedure setline; ! end of line routine. must check for sup/sub hacking;
begin "SL"
debug("run_lngth is"&cvs(run_lngth)&crlf);
debug("pwidth is"&cvs(pwidth)&crlf);
if uc then begin stuff(unshift);uc←false; end;
if run_lngth≠pwidth ∧ run_lngth≠0 then begin
line_meas(run_lngth);
pwidth←run_lngth;
seen_bnd←false;
end;
run_lngth←0;
if tab_cnt>0 then begin tab_to(pwidth);
loc←loc-1;
tab_set(tab_cnt);
end;
if sup then begin
punch_sum("040");! should compute this on basis of font size;
burp(punch_buf,
flash,
noflash,
noflash);
punch_sum("080"); ! should compute this on basis of font size!;
end;
burp(punch_buf,
noflash,
noflash,
flash);
if sub then begin
punch_sum("100");
burp(punch_buf,
noflash,
flash,
noflash);
loc←0;
punch_sum("020"); ! should compute this on basis of font size!;
punch(bell);
punch(eight);
end
else loc←0;
sub←sup←false;
text_set←false;
if tab_cnt>0 then begin punch(bell);
punch(zee);
end;
tab_cnt←0;
last_col←0; ! *********!!!!;
end "SL";
! proc linesp(integer n);
! linesp figures the leading to give non-standard interline spacing;
proc linesp(integer n);
begin "LS"
integer m;
m←abs((xline-n)/(pix_pnt/2.0));
if m≠0 then begin
string s,s1;
setformat(-3,0);
s←cvs(m MOD 2);
s1←lop(s);
! bellit;
! typeset("m"&cvs((m DIV 2)*10+(m MOD 2))&(if xline>n then ","else "."));
! geezus, is that ugly!!!;
punch(bell);
punch(emm);
punch_num(cvs((m DIV 2)*10+(m MOD 2)));
punch(if xline>n then comma else period);
end;
end "LS";
begin "MAIN PROGRAM"
setbreak(topar←getbreak, "()", null, "INS");
setbreak(tospeq←getbreak, " =", null, "INS");
setbreak(toppn←getbreak, "[", null, "INR");
setbreak(todot←getbreak, ".",null, "INS");
setbreak(tocolon←getbreak, ":", null,"INS");
while true do
begin "IN"
outstr("name.ext (n:m)? (n≥2; always uses page 1)
");
open (inchan,"DSK",0,2,0,200,0,eof);
open (ptpchan, "PTP", '10,0,2,0,0,0);
! initialize some crap;
seen_bnd←true; ! initialized true to force initial line length;
run_lngth←0;
pwidth ← -1;
uc ← false;
loc←0;
cur_size←null;
cur_font_no←-1;
cur_indent←-1;
text_set←false;
tab_cnt←0;
last_col←0; ! *************;
offset←370;
pix_pnt←200.0/72.0;
while true do
begin "file"
string file;
outstr("*");
S← inchwl;
ext ←scan(s,topar,i);
file←scan(ext,todot,i);
if length(ext)=0 then ext←"TYP";
s1←cvxstr(call(0,"dskppn"));
if defile(inchan,file,ext,s1[1 to 3],s1[4 to 6])
then outstr("FILE NOT FOUND: "&file&crlf)
else done;
end "file";
outstr("output to tty? yes → tty; no→ punch.(y/n)?"&crlf);
s1←inchwl;
if s1="y" or s1="Y" then foo ←true else foo←false;
comment add crap for page number location (suck for "<FF>");
if s=null then begin
pagebeg←2;
pagend←7000;
end
else begin
pagebeg←cvd(scan(s,tocolon,i));
if s="*" then pagend←7000
else pagend←cvd(s);
end;
comment read page 1;
BEGIN "PAGE1"
setbreak(page1←getbreak,"/<>=#",crlfff,"INS");
s1←input(inchan,page1); ! flush leading cr-lf and "/";
if length(s1)≠0
then begin
outstr(cvs(length(s1))&" not proper file format"&crlf);done
end;
s1←input(inchan,page1); ! snarf "lmar=";
lmar←cvd(input(inchan,page1)); ! save left margin setting;
s1←input(inchan,page1); ! snarf "xline=";
xline←cvd(input(inchan,page1)); ! save leading;
while true do
begin "FONTS"
integer f;
string name,s3,s4,f1;
if equ(input(inchan,page1), "CR") ! scan to"#" to get to font number;
then done;
f←cvd(f1 ← input(inchan,page1));! get font number;
name ← input(inchan,page1); ! get sail font name;
cw_init(name,f); ! get chr widths of name and stuff in cw[f,0:127];
if font[f]=null then begin "ask font"
outstr("font "&f1&" is "&name&crlf);
outstr("give VIP position and point size (a-c&1-6&(1-99))
*");
s3←inchwl;
s4←scan(s3,topar,i);
font[f]←s4;
s4←scan(s3,topar,i);
fontsize[f]←s4;
end "ask font";
if equ(name,"SUB") then subfont←f
else if equ(name,"SUP") then supfont←f;
end "FONTS";
font[16]←"a3"; ! vip position for greek math;
fontsize[16]←"10"; ! point size;
! outstr("linelength in picas and points (aaoo)?"&crlf&"*");
width ← cvd(swidth←"4000");
pwidth←pix_pnt*12.*(width/100.);
! outstr("standard leading (points and half-points (ooh)?"&crlf&"*");
! lead ← cvd(slead←inchwl);
lead ← (lead+xline)/(pix_pnt/2.0);
slead← cvs((lead DIV 2)*10+(lead MOD 2)); ! lead set in cw_init;
END "PAGE1";
page←2;
input(inchan,page1); ! snarf "<";
input(inchan,page1); ! snarf "LF>";
input(inchan,page1); ! snarf "<";
input(inchan,page1); ! snarf "FF>";
film_adv(slead); ! punch film advance;
line_meas(pwidth); ! punch line page width;
punch(bell);
punch(jay); ! do it in justified mode;
setbreak(tolb←getbreak,"<",crlfffsp,"INS");
setbreak(torb←getbreak,">",crlfff,"INS");
while page≠pagebeg do
begin "suck"
s←input(inchan,tolb);
s←input(inchan,torb);
if equ(s,"FF") then page←page+1;
end"suck";
while page ≤pagend and not eof do
BEGIN "SET TEXT"
while not eof do
BEGIN "SET PAGE"
s←input(inchan,tolb);
if length(s)≠0 then begin
run_lngth←run_lngth+comp_lngth(s);
typeset(s);
text_set←true;
end;
s←input(inchan,torb);
debug(" "&s&crlf);
if equ(s,"SP") then begin "foo1"
run_lngth←run_lngth+comp_lngth(" ");
stuff(thin); ! *********stuff(ensp);
end "foo1"
else if equ(s,"CR") then setline
else if equ(s,"LF") then continue
else if equ(s,"LB")then begin
run_lngth←run_lngth+comp_lngth("<");
typeset("<");
end
else if equ(s,"RB")then begin
run_lngth←run_lngth+comp_lngth(">");
typeset(">");
end
else if equ(s,"FF") then begin "foo"
page←page+1;
punch(QL);punch(elev);
punch(QL);punch(elev);
punch(QL);punch(elev);
punch(QL);punch(elev);
punch(QL);punch(elev);
punch(QL);punch(elev);
punch(QL);punch(elev);
done end "foo"
else begin "BIGcommand"
string s1;
integer br;
s1←scan(s,tospeq,br);
if length(s)=0 then begin outstr("FOO on "&s1&crlf);continue end;
if equ(s1,"COLUMN") then begin
tab_to(cvd(s));
text_set←false;
run_lngth←cvd(s)
end
else if equ(s1,"FONT") then setfont(cvd(s))
else if equ(s1,"LINESPACE") then linesp(cvd(s))
else if equ(s1,"COL") then begin "col inc"
stuff(bnd);
s1←scan(s,tospeq,br); ! flush "INC";
run_lngth←run_lngth+cvd(s);
seen_bnd←true;
end "col inc"
else outstr("unrecognized command: "&s1&crlf);
end "BIGcommand";
end "SET PAGE";
end "SET TEXT";
bellit;
typeset("s");
setline
end "IN";
end "MAIN PROGRAM";
end "TYPESET"